unit SPRest;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, Db, FMTBcd, SqlExpr;

type
  TSP = class(TDataModule)
    NewSP: TSQLDataSet;
    OldSP: TSQLDataSet;
    NewSPParam: TSQLDataSet;
    OldSPParam: TSQLDataSet;
    NewSPFields: TSQLDataSet;
    OldSPFields: TSQLDataSet;
    NewSPDep: TSQLDataSet;
    SrchNewSP: TSQLDataSet;
    SrchOldSP: TSQLDataSet;
  private
    { Private declarations }
    function SPParamDB(DBType : Integer) : TSQLDataSet;
    function SPFieldsDB(DBType : Integer) : TSQLDataSet;
    function SPSrchDB(DBType: Integer): TSQLDataSet;

    function FieldSize(DBType : Integer) : String;
    function FieldPrecision(DBType: Byte): String;
    function FieldScale(DBType: Byte): String;
    function FieldType(DBType : Integer) : Integer;
    function FieldSource(DBType : Integer) : String;
    function ParamName(DBType : Integer) : String;

    function GetParameterType(DBType : Integer) : String;
    function CreateParameters(DBType : Integer) : String;
    procedure CreateInputParameters(SPName : String; DBType : Integer; S : TStrings);
    procedure CreateOutputParameters(SPName : String; DBType : Integer; S : TStrings);
    procedure CreateSQLStatement(SPName : String; DBType : Integer; S : TStrings);
    function ParametersCountEqual(SPName : String) : Boolean; 
    procedure CheckDependencies(SPName : String);
  public
    { Public declarations }
    procedure CheckStoredProcedure(SPName : String);
    procedure CreateStoredProcedure(SPName : String);
    procedure AlterStoredProcedure(SPName : String);
  end;

var
  SP: TSP;

procedure CheckStoredProcedures(ProgBar : TProgressBar);

implementation

uses Data, ReportForm, DropRest;

{$R *.DFM}

procedure CheckStoredProcedures;

begin
  ProgBar.Position:=0;
  // how many procedures are there ?
  SP.NewSP.CommandText:=
    'select count(*) as ccc from RDB$PROCEDURES';
  SP.NewSP.Open;
  ProgBar.Max:=SP.NewSP.fieldByName('ccc').AsInteger;
  SP.NewSP.Close;

  SP.NewSP.CommandText:=
    'select * from RDB$PROCEDURES';

  SP.NewSP.Open;
  SP.OldSP.Open;

  SP.SrchNewSP.Open;
  SP.SrchOldSP.Open;
  SP.NewSPDep.Open;

  SP.NewSP.First;
  While not SP.NewSP.Eof do
  begin
    Application.ProcessMessages;
    ProgBar.Position:=ProgBar.Position+1;
    SP.CheckStoredProcedure(SP.NewSP.FieldbyName('RDB$PROCEDURE_NAME').AsString);
    SP.NewSP.Next;
  end;
  SP.OldSP.Close;
  SP.NewSP.Close;

  SP.SrchOldSP.Close;
  SP.SrchNewSP.Close;
  SP.NewSPDep.Close;
  SP.NewSP.Close;
end;

{ TSP }

function TSP.SPFieldsDB(DBType: Integer): TSQLDataSet;
begin
  case DBType of
    fcNew : Result:=NewSPFields;
    fcOld : Result:=OldSPFields;
  end;
end;

function TSP.SPParamDB(DBType: Integer): TSQLDataSet;
begin
  case DBType of
    fcNew : Result:=NewSPParam;
    fcOld : Result:=OldSPParam;
  end;
end;

function TSP.SPSrchDB(DBType: Integer): TSQLDataSet;
begin
  case DBType of
    fcNew : Result:=SrchNewSP;
    fcOld : Result:=SrchOldSP;
  end;
end;

function TSP.FieldSource(DBType : Integer) : String;
begin
  Result:=SPParamDB(DBType).FieldByName('RDB$FIELD_SOURCE').AsString;
end;

function TSP.ParamName(DBType : Integer) : String;
begin
  Result:=Trim(SPParamDB(DBType).FieldByName('RDB$PARAMETER_NAME').AsString);
end;

function TSP.FieldSize(DBType : Integer) : String;
begin
  Result:=SPFieldsDB(DBType).FieldByName('RDB$FIELD_LENGTH').AsString;
end;

function TSP.FieldPrecision(DBType: Byte): String;
begin
  Result:=SPFieldsDB(DBType).FieldByName('RDB$FIELD_PRECISION').AsString;
end;

function TSP.FieldScale(DBType: Byte): String;
begin
  Result:=IntToStr(-SPFieldsDB(DBType).FieldByName('RDB$FIELD_SCALE').AsInteger);
end;

function TSP.FieldType(DBType : Integer) : Integer;
begin
  Result:=SPFieldsDB(DBType).FieldByName('RDB$FIELD_TYPE').AsInteger;
end;

procedure TSP.CheckStoredProcedure(SPName : String);
var SPSrcOk,
    SPExist : Boolean;
    OldSt,
    NewSt : TStringList;
begin
  SPExist:=True;
  SPSrcOk:=True;
  OldSt:=TStringList.Create;
  OldSt.Clear;
  NewSt:=TStringList.Create;
  NewSt.Clear;
  // does proc exist ?
  OldSP.Close;
  OldSP.ParamByName('PName').AsString:=SPName;
  OldSP.Open;
  if Trim(OldSP.FieldByName('RDB$PROCEDURE_NAME').AsString)=Trim(SPName) then
  begin
    CreateSQLStatement(SPName,fcNew,NewSt);
    CreateSQLStatement(SPName,fcOld,OldSt);
    SPSrcOk:=OldSt.Equals(NewSt);
//    if not SPSrcOk then
//      ShowMessage('SP : '+SPName+#13#10'Old : '#13#10+OldSt.Text+#13#10'New : '#13#10+NewSt.Text);
  end
    else SPExist:=False;

  if not SPExist then CreateStoredProcedure(SPName) else
    if not SPSrcOk then AlterStoredProcedure(SPName) {else
      if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'Ok')};

  OldSt.Free;
  NewSt.Free;
end;

procedure TSP.CheckDependencies(SPName : String);
var B : TBookmark;
    Q : TSQLDataSet;

    procedure SetRange;
    begin
      if Q.Active then Q.Close;
      Q.ParamByName('SPNAME').AsString:=SPName;
      Q.ParamByName('DEPTYPE').AsInteger:=5;
      Q.Open;
    end;

begin
  // does procedure depends from other procedure ?
  Q:=DM.CreateQueryNewDB;
  Q.CommandText:=NewSPDep.CommandText;
  SetRange;
  Q.First;
  While not Q.Eof do
  begin
    SPSrchDB(fcNew).Locate('RDB$PROCEDURE_NAME',Q.FieldByName('RDB$DEPENDED_ON_NAME').AsString,[]);
    // procedura lahko klice samo sebe, takrat preskocim
    if SPName<>SPSrchDB(fcNew).FieldByName('RDB$PROCEDURE_NAME').AsString then
      CheckStoredProcedure(SPSrchDB(fcNew).FieldByName('RDB$PROCEDURE_NAME').AsString);
    Q.Next;
  end;
  Q.Close;
  Q.Free;
end;

function TSP.GetParameterType(DBType : Integer) : String;
begin
  SPFieldsDB(DBType).ParamByName('FNAME').AsString:=FieldSource(DBType);
  SPFieldsDB(DBType).Open;
  Result:=Trim(ParamName(DBType))+' ';
  case SPFieldsDB(DBType).FieldByName('RDB$FIELD_TYPE').AsInteger of
    7  : Result:=Result+'SMALLINT';
    8  : Result:=Result+'INTEGER';
    10 : Result:=Result+'FLOAT';
    12 : Result:=Result+'DATE'; // in dialect 3
    13 : Result:=Result+'TIME'; // in dialect 3
    14 : Result:=Result+'CHAR('+FieldSize(DBType)+')';
    16 : Result:=Result+'NUMERIC('+FieldPrecision(DBType)+','+FieldScale(DBType)+')';
    27 : Result:=Result+'DOUBLE PRECISION';
    35 : if DM.Dialect=1 then
           Result:=Result+'DATE' // in dialect 1
         else
           Result:=Result+'TIMESTAMP'; // in dialect 3
    37 : Result:=Result+'VARCHAR('+FieldSize(DBType)+')';
    261: Result:=Result+'BLOB';
  end;
  SPFieldsDB(DBType).Close;
end;

function TSP.ParametersCountEqual(SPName: String): Boolean;
var NewCount,
    OldCount : Integer;
begin
  // does new SP have a different numbers input parameters ?
  SPParamDB(fcNew).ParamByName('PNAME').AsString:=SPName;
  SPParamDB(fcNew).ParamByName('PTYPE').AsInteger:=0;
  SPParamDB(fcNew).Open;
  NewCount:=0;
  SPParamDB(fcNew).First;
  While not SPParamDB(fcNew).Eof do
  begin
    Inc(NewCount);
    SPParamDB(fcNew).Next;
  end;

  //NewCount:=TSQLDataSet(SPParamDB(fcNew)).RecordCount;
  SPParamDB(fcNew).Close;

  SPParamDB(fcOld).ParamByName('PNAME').AsString:=SPName;
  SPParamDB(fcOld).ParamByName('PTYPE').AsInteger:=0;
  SPParamDB(fcOld).Open;
  OldCount:=0;
  SPParamDB(fcOld).First;
  While not SPParamDB(fcOld).Eof do
  begin
    Inc(OldCount);
    SPParamDB(fcOld).Next;
  end;
  SPParamDB(fcOld).Close;

  Result:=NewCount=OldCount;
end;

function TSP.CreateParameters(DBType : Integer) : String;
var FirstParam : Boolean;
begin
  Result:='';
  SPParamDB(DBType).Open;
  SPParamDB(DBType).First;
  if not SPParamDB(DBType).Eof then
  begin
    Result:='(';
    FirstParam:=True;
    While not SPParamDB(DBType).Eof do
    begin
      if not FirstParam then Result:=Result+', ';
      Result:=Result+GetParameterType(DBType);
      SPParamDB(DBType).Next;
      FirstParam:=False;
    end;
    Result:=Result+')';
  end;
  SPParamDB(DBType).Close;
  SPParamDB(DBType).Close;
end;

procedure TSP.CreateInputParameters(SPName : String; DBType : Integer; S : TStrings);
var St: String;
begin
  SPParamDB(DBType).ParamByName('PNAME').AsString:=SPName;
  SPParamDB(DBType).ParamByName('PTYPE').AsInteger:=0;
  St:=CreateParameters(DBType);
  S.Add(St);
end;

procedure TSP.CreateOutputParameters(SPName : String; DBType : Integer; S : TStrings);
var St : String;
begin
  SPParamDB(DBType).ParamByName('PNAME').AsString:=SPName;
  SPParamDB(DBType).ParamByName('PTYPE').AsInteger:=1;
  St:=CreateParameters(DBType);
  if St<>'' then S.Add('RETURNS '+St);
end;

procedure TSP.CreateSQLStatement(SPName : String; DBType : Integer; S : TStrings);
begin
  CreateInputParameters(SPName, DBType, S);
  CreateOutputParameters(SPName, DBType, S);
  SPSrchDB(DBType).Locate('RDB$PROCEDURE_NAME',SPName,[]);
  S.Add('as'+SPSrchDB(DBType).FieldByName('RDB$PROCEDURE_SOURCE').AsString);
end;

procedure TSP.CreateStoredProcedure(SPName : String);
begin
  // first I must check dependencies
  CheckDependencies(SPName);

  DM.SQL.Clear;
  DM.SQL.Add('CREATE PROCEDURE '+SPName);
  CreateSQLStatement(SPName,fcNew,DM.SQL);

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'not exist');
    except
      if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'error');
  end;
  end else
  begin
    DM.AddToStrings('STORED PROC '+Trim(SPName),DM.SQL);
    if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'not exist');
  end;
end;

procedure TSP.AlterStoredProcedure(SPName : String);
var B : TBookmark;
    St : TStringList;
    S1,
    S2  : String;
    Rec : Boolean;
begin
  // first I must check dependencies
  CheckDependencies(SPName);

  // second - if there is a different number of input parameters
  // I must drop all objects dependend on SP
  if not ParametersCountEqual(SPName) then Drop.Run(SPName,5,False);

  St:=TStringList.Create;
  CreateSQLStatement(SPName,fcNew,St);

  // is there a recursion ?
  Rec:=False;
  S1:=St.Text;
  While Pos('/* begin recursion',S1)<>0 do
  begin
    Rec:=True;
    // o, yes, Houston, we have problems
    // first I will create procedure without recursion part
    S2:=Copy(St.Text,1,Pos('/* begin recursion',S1)-1);
    Delete(S1,1,Pos('end recursion */',S1)+16);
    S1:=S2+S1;
  end;
  DM.SQL.Clear;
  DM.SQL.Add('ALTER PROCEDURE '+SPName);
  DM.SQL.Add(S1);
  if DM.AutoRepair then
    DM.ExecRunSQL
  else
    DM.AddToStrings('STORED PROC '+Trim(SPName),DM.sql);
  St.Free;

  DM.SQL.Clear;
  DM.SQL.Add('ALTER PROCEDURE '+SPName);
  CreateSQLStatement(SPName,fcNew,DM.SQL);

  if DM.AutoRepair then
  begin
    try
      DM.ExecRunSQL;
      if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'different');
    except
      if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'error');
    end;
  end else
  begin
    DM.AddToStrings('STORED PROC '+Trim(SPName),DM.sql);
    if DM.ShowReport then Rep.AddToReport('STORED PROC.',Trim(SPName),'different');
  end;
end;

end.
